
import Debug.QuickCheck

---------------------------------------------------------------------------
-- 1. Muliplying list elements

-- multiply xs multiplies all elements in the list xs
multiply :: Num a => [a] -> a
multiply []     = 1
multiply (x:xs) = x * multiply xs

---------------------------------------------------------------------------
-- 2. Avoiding Duplicates

-- duplicates xs checks if there are duplicates in the list xs
duplicates :: Eq a => [a] -> Bool
duplicates []     = False
duplicates (x:xs) = exists x xs || duplicates xs

-- exists x xs checks whether x exists as an element in the list xs
exists :: Eq a => a -> [a] -> Bool
exists x []     = False
exists x (y:ys) = x == y || exists x ys

-- Note: "exists" is the standard Haskell function "elem"

-- removeDuplicates xs returns the list xs with all duplicate elements removed
removeDuplicates :: Eq a => [a] -> [a]
removeDuplicates []     = []
removeDuplicates (x:xs) = x : removeDuplicates (remove x xs)

-- remove x xs removes x from the list xs
remove :: Eq a => a -> [a] -> [a]
remove x []                 = []
remove x (y:ys) | x == y    = remove x ys
                | otherwise = y : remove x ys

{-
-- alternative solution:
-- (returns elements in different order!)

-- removeDuplicates xs returns the list xs with all duplicate elements removed
removeDuplicates :: Eq a => [a] -> [a]
removeDuplicates []                   = []
removeDuplicates (x:xs) | exists x xs = removeDuplicates xs
                        | otherwise   = x : removeDuplicates xs
-}

-- No, the property does not guarantee this. A function always returning the
-- empty list would also satisfy the property!

-- Missing is a property that checks that no elements disappear:

prop_RemoveDuplicatesKeepsElements xs =
  allExist xs (removeDuplicates xs)

-- allExist xs ys checks whether all x in xs exist as an element in ys
allExist :: Eq a => [a] -> [a] -> Bool
allExist []     ys = True
allExist (x:xs) ys = exists x ys && allExist xs ys

---------------------------------------------------------------------------
-- 3. Permutations

-- isPermutation xs ys checks whether xs is a permutation of ys
isPermutation :: Eq a => [a] -> [a] -> Bool
isPermutation []     []     = True
isPermutation []     (y:ys) = False
isPermutation (x:xs) ys     = exists x ys && isPermutation xs (removeOnce x ys)

-- removeOnce x xs removes x from the list xs, but only once
removeOnce :: Eq a => a -> [a] -> [a]
removeOnce x []                 = []
removeOnce x (y:ys) | x == y    = ys
                    | otherwise = y : removeOnce x ys

-- backwards xs reverses the elements in the list xs
backwards :: [a] -> [a]
backwards []     = []
backwards (x:xs) = atBack x (backwards xs)
 where
  atBack x []     = [x]
  atBack x (y:ys) = y : atBack x ys

---------------------------------------------------------------------------
-- 4. Sorting

-- sorted xs checks whether the list xs is sorted
sorted :: Ord a => [a] -> Bool
sorted []       = True
sorted [x]      = True
sorted (x:y:xs) = x <= y && sorted (y:xs)

-- Note: Why don't we have to check that x <= all elements in (y:ys)?

-- insert' x xs inserts x in the sorted list xs, at the right place
insert' :: Ord a => a -> [a] -> [a]
insert' x [] = [x]
insert' x (y:ys)
  | x <= y    = x : y : ys
  | otherwise = y : insert' x ys

-- isort xs produces the sorted version of the list xs
isort :: Ord a => [a] -> [a]
isort []     = []
isort (x:xs) = insert' x (isort xs)

prop_Sorted :: [Integer] -> Bool
prop_Sorted xs =
  sorted (isort xs)

prop_Permutation :: [Integer] -> Bool
prop_Permutation xs =
  isPermutation xs (isort xs)

---------------------------------------------------------------------------
-- 5. Testing

-- datatype for rank of a card
data Rank = Numeric Integer | Jack | Queen | King | Ace
  deriving (Eq, Show)

instance Arbitrary Rank where
  arbitrary =
    oneof $
      [ do return c
      | c <- [Jack,Queen,King,Ace]
      ] ++
      [ do n <- choose (2,10)
           return (Numeric n)
      ]

-- rankBeats rank1 rank2 checks if rank1 beats rank2
rankBeats :: Rank -> Rank -> Bool
rankBeats _           Ace         = False
rankBeats Ace         _           = True
rankBeats _           King        = False
rankBeats King        _           = True
rankBeats _           Queen       = True
rankBeats Queen       _           = True
rankBeats _           Jack        = False
rankBeats Jack        _           = True
rankBeats (Numeric m) (Numeric n) = m > n

-- rankBeats is strict ordering, i.e. a cannot beat b if b beats a, and
-- a cannot not beat b if b does not beat a. In other words, for different
-- a and b, the results should be different.
prop_RankBeatsStrict a b =
  a /= b ==>
    rankBeats a b /= rankBeats b a

-- Note: What is the relationship between this property and the one
-- in the lecture?

-- alternative properties:
prop_RankBeats1 a b =
  rankBeats a b ==>
    not (rankBeats b a)

prop_RankBeats2 a b =
  not (rankBeats a b) && a /= b ==>
    rankBeats b a

-- Note: Why should we NOT have a/=b as a condition in the prop_rankBeat1?

-- Here is one more interesting property:
prop_RankBeatsSame a =
  not (rankBeats a a)

---------------------------------------------------------------------------
-- 6. Card Play

{- free solutions -}

---------------------------------------------------------------------------
-- 7. Defining Types

-- a datatype for months
data Month
  = January
  | February
  | March
  | April
  | May
  | June 
  | July
  | August
  | September
  | October
  | November
  | December
 deriving ( Eq, Show )

-- daysInMonth month year returns the days in the month in the year
daysInMonth :: Month -> Integer -> Integer
daysInMonth January   year = 31
daysInMonth February  year 
  | leap year              = 29
  | otherwise              = 28                    
daysInMonth March     year = 31
daysInMonth April     year = 30
daysInMonth May       year = 31
daysInMonth June      year = 30
daysInMonth July      year = 31
daysInMonth August    year = 31
daysInMonth September year = 30
daysInMonth October   year = 31
daysInMonth November  year = 30
daysInMonth December  year = 31

-- leap year approximates whether year is a leap year
leap :: Integer -> Bool
leap year = year `mod` 4 == 0

-- a datatype for dates
data Date = Date{ year :: Integer, month :: Month, day :: Integer }

-- validDate date checks whether date is a valid date, regarding
-- numbers of days in the month
validDate :: Date -> Bool
validDate date = 1 <= day date
                   && day date <= daysInMonth (month date) (year date)

---------------------------------------------------------------------------
